home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
menus
/
toadmenu.zip
/
TOADMENU.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1987-10-30
|
8KB
|
240 lines
PROGRAM toadmenu;
(*
Copyright (C) David P Kirschbaum All Rights Reserved
I maintain the copyright and all commercial rights to TOADMENU.
The program and source code, however, may be freely distributed, copied,
and used for any purpose so long as the following conditions are met:
Author's name and copyright are not removed from the program or
source code.
The program name is not significantly changed from TOADMENU.
(Version numbers, if patched, may be indicated by replacing the
last character with the version number (TOADMEN1, TOADMEN2, etc.).
All credits remain in the source code.
Distribution or copying fees do not exceed $6.00.
The source code, sample TOADMENU.DAT, and documentation must be
distributed with the executable program.
Author: David P Kirschbaum
Toad Hall
kirsch@braggvax.ARPA
Credits:
AUTOMENU (TP_MENU.PAS) by Joseph G. Solch
EXEC.PAS
v1.1 - Bela Lubkin
Borland International Technical Support
CompuServe 71016,1573
v1.2 - James Tuksal
Burroughs Corporation
14115 Farmington Rd.
Livonia, Michigan 48154
BOX.PAS by DAVID W. TERRY SEPT. 1, 1985
3036 PUTNAM CT.
WEST VALLEY CITY, UT 84120
*)
{$V-} {relax string parm testing}
{ R-} {no runtime index checks}
{$C-} {No Ctrl C, Ctrl S checking}
{Compile with mIninum stack space = 100
mAximim stack space = 100
(required by the EXEC function)
}
TYPE
Str20 = STRING[20];
Str40 = STRING[40];
Str64 = STRING[64];
Str78 = STRING[78];
Str80 = STRING[80];
Str255 = STRING[255];
MenuItem = Str20; {max length for a menu display}
MenuSelection = ARRAY[1..20] OF Str20; {menu display items}
CmdSelection = ARRAY[1..20] OF Str64; {item-associated DOS commands}
TxtSelection = ARRAY[1..20] OF Str78; {item-associated text}
Regpack = RECORD CASE INTEGER OF
0 : (ax,bx,cx,dx,bp,si,di,ds,es,flags : INTEGER);
1 : (al,ah,bl,bh,cl,ch,dl,dh : BYTE);
END;
curs_cond = (on,off);
CONST
M_Y = 6; {y coord for menu window top}
T_Y = 19; {y coord for text window top (and menu window bottom)}
Fkey : ARRAY[1..10] OF STRING[3] = {string display of Func Keys}
('F1 ', 'F2 ', 'F3 ', 'F4 ', 'F5 ',
'F6 ', 'F7 ', 'F8 ', 'F9 ', 'F10');
SecKey : STRING[10] = ';<=>?@ABCD'; {2d char in Turbo Func Key}
MenuTitle : STRING[12] = ' TOADMENU '; {title at top of menu}
default : INTEGER = 10; {start at menu item 10 (always Exit) }
VAR
PALLETTE : BYTE ABSOLUTE $0000:$0466; {system color pallette}
len, {global length variable}
maxlen, {remembers widest text or cmd}
x,y, {global coord variables}
z : INTEGER; {global variable}
Regs : Regpack;
Item : MenuSelection; {menu item}
Cmd : CmdSelection; {item-associated DOS commands}
Txt : TxtSelection; {item-associated text}
CmdParm : Str80; {any user cmd parms to pass to DOS}
MenuFile : TEXT; {text file with menus, cmds, txt}
oldcolor : BYTE; {save orig system pallette}
Color : BOOLEAN; {color or mono system}
{stuff from menu.inc}
VAR
minptr,maxptr, {legal range of menu items}
last, {remember last menuptr}
t_x, {text box left coords}
m_x, {menu box upper left x/y coords}
maxtxtlen, {max text length}
maxitemlen : INTEGER; {longest menu item}
HlChar : STRING[20]; {desired highlighted chars}
hlcharpos : ARRAY[1..20] OF INTEGER; {each char's psn in
its item string}
InChar : CHAR;
LenOver10, {TH}
FirstMenu : BOOLEAN;
menuptr,
menulen : 1..20;
CurrentDir : Str64; {remember current drive,subdir}
Legend : Str40;
(*
Types and variables for BOX procedure in MENUTIL.INC
*)
TYPE
x_scrn_Type = ARRAY[1..2000] OF INTEGER;
y_scrn_Type = ARRAY[1..25,1..80] OF INTEGER;
VAR
x_scrn : ^x_scrn_Type;
y_scrn : ^y_scrn_Type;
{$I MENUTIL.INC}
{$I MENU.INC}
{$I NEWEXEC.INC}
BEGIN
Assign(MenuFile,'TOADMENU.DAT');
{$I-}
Reset(MenuFile); {open our menu text file}
{$I+}
IF IOresult <> 0 THEN BEGIN {failed somehow}
Writeln('TOADMENU cannot find its command file "TOADMENU.DAT"!');
Writeln('TOADMENU aborting!');
END;
ClrScr;
HlChar := ' '; {initialize to all blanks}
{Format of file should be:
B,Basic,*GWBASIC%
where first fieldr is the desired highlighted char,
second field is the desired menu display,
third field is the appropriate DOS command line stub (if any).
Second line in the text file is item-associated text (or blank).
}
menuptr := 1;
maxtxtlen := 20; {minimum text window width}
maxitemlen := 12; {minimum menu window width}
{Just using CmdParm here as a working string}
WHILE (NOT EOF(MenuFile)) AND (menuptr < 21) DO BEGIN
Readln(MenuFile,CmdParm); {actual Menu item display}
IF CmdParm[1] <> ';' THEN BEGIN {not a comment}
HlChar[menuptr] := CmdParm[1]; {first char is highlight char}
Delete(CmdParm,1,2); {gobble char, comma}
x := POS(',', CmdParm); {find end of 2d field}
IF x > 0 THEN BEGIN {we have a 3d field}
Item[menuptr] := Copy(CmdParm,1,PRED(x));{copy 2d parm}
Delete(CmdParm,1,x); {delete 2d parm, comma}
END
ELSE BEGIN
Item[menuptr] := CmdParm; {read in what we got}
CmdParm := ''; {blank out for DOS cmd}
END;
len := LENGTH(Item[menuptr]); {get item length}
IF len > maxitemlen {find the longest item}
THEN maxitemlen := len; {and remember its length}
Cmd[menuptr] := CmdParm; {may be blank}
Readln(MenuFile,Txt[menuptr]); {read in associated text}
len := LENGTH(Txt[menuptr]); {may be blank}
IF len > maxtxtlen THEN maxtxtlen := len; {remember longest}
menuptr := SUCC(menuptr); {bump counter}
END;
END;
Item[menuptr] := ''; {terminate with blank item}
menulen := PRED(menuptr);
maxitemlen := maxitemlen + 8; {need it wider}
Close(MenuFile);
Init_Menu; {initialize menu vars}
Repeat
CmdParm := ''; {Clear the DOS command parm}
z := menu; {do the menu}
IF CmdParm <> '' THEN BEGIN {Any DOS command parm returned?}
IF CmdParm[1] = '*' {we need COMMAND.COM}
THEN CmdParm := GetComSpec+' /C '+COPY (CmdParm, 2, 78);
x := subProcess(CmdParm); {do the Exec}
IF x <> 0 THEN BEGIN {DOS-returned value}
GotoXY(1,24);
WRITE ('ToadMenu DOS Returned :',x, ' [');
CASE x OF
{0: Writeln('Success'); }
1: Writeln('Invalid function]');
2: Writeln('File/path not found]');
8: Writeln('Not enough memory to load program]');
10: Writeln('Bad environment (greater than 32K)]');
11: Writeln('Illegal .EXE file format]');
ELSE Writeln('DOS returned value]');
END; {case}
END;
IF Color THEN BEGIN {Illuminate prompt}
TextColor(WHITE);
TextBackGround(RED);
END
ELSE RvsOn;
GotoXY(1,25);
Write('ToadMenu: press any key: ');
Repeat Until Keypressed; Read(Kbd,Inchar); {wait for user}
RvsOff;
InChar := ' ';
END